Eagles Nest BBS 8/Eagles_Nest_Mac_Collection_Disc_8.TOAST/Developer Environments/TurPasDBTlbx/TP-Database Toolbox/BTree Sample/BTree.pas

Pascal/Delphi Source File | 1987-12-11 | 40.5 KB | 1,347 lines | [TEXT/TPAS]

(*********************************************************************)
(*                  Turbo Pascal Database Toolbox                    *)
(*                       For the Macintosh                           *)
(*            Copyright (C) 1987 Borland International               *)
(*                    Toolbox version: 1.0                           *)
(*                                                                   *)
(*              BTree - A Sample Customer Database                   *)
(*                                                                   *)
(*  Implements a database that has one data file and 2 index files.  *)
(*  Unlike the simpler examples in the Access Samples folder, BTree  *)
(*  displays a full-blown "Macintosh User Interface".                *)
(*                                                                   *)
(*********************************************************************)

(*********************************************************************)
(*              BTree - Configuration for compilation                *)
(*                                                                   *)
(*    Follow these steps in order to compile BTree.pas:              *)
(*                                                                   *)
(*    1.  Copy TAccess.unit from the Turbo Access folder into the    *)
(*        folder or disk that contains Btree.pas.                    *)
(*                                                                   *)
(*    2.  Bring the source for TAccess.unit into the Turbo Pascal    *)
(*        integrated environment.                                    *)
(*                                                                   *)
(*    3.  Modify the $I include file directive to this syntax:       *)
(*        {$I BTree.const}                                           *)
(*                                                                   *)
(*    4.  Compile TAccess.unit to disk.                              *)
(*                                                                   *)
(*    5.  Bring the BTreeTA.unit source into the Turbo Pascal        *)
(*        environment and compile it to disk.                        *)
(*                                                                   *)
(*    6.  Bring the BTree.pas source file into the Turbo Pascal      *)
(*        environment.                                               *)
(*                                                                   *)
(*    7.  Run BTree in memory or compile to disk.                    *)
(*                                                                   *)
(*    For further reference, see pages 34-39 of the Turbo Pascal     *)
(*    Database Toolbox Owner's Handbook.                             *)
(*                                                                   *)
(*********************************************************************)

program BTree;
{$U-}
{$U TAccess}
{$U BTreeTA}
{$R BTree.rsrc}
{$S+}
uses
 {If a compiler error occurs here, Turbo Pascal cannot find the TAccess
  and BTreeTA units. You must first compile these units to this disk
  (or folder if using HFS) before compiling Btree.  See the top of
  this file for detailed instructions.
 }
memtypes,
{$S QuickDraw} QuickDraw,
{$S OSIntf} OSIntf,
{$S ToolIntf} ToolIntf,PackIntf,PasInOut,
{$S TAccess} TAccess,
{$S BTreeTA} BTreeTA;

const
  MenuCnt      = 5;
  applMenuID   = 128;
  fileMenuID   = 129;
    quitItem   = 1;
  editMenuID   = 130;
    undoItem   = 1;
    cutItem    = 3;
    copyItem   = 4;
    pasteItem  = 5;
    clearItem  = 6;
  dataMenuID   = 131;
    AddRecItem = 1;
    DelRecItem = 2;
    ListVItem  = 4;
  srchMenuID   = 132;
    FirstItem  = 1;
    LastItem   = 2;
    NextItem   = 3;
    PrevItem   = 4;
    SOnItem    = 6;

  MenuStart   = applMenuID;

  srchDLogID       = 128;
    FindExact      = 3;
    LNameSearch    = 4;
    CustCodeSearch = 5;
    SearchText     = 6;
  entrDLogID       = 129;
    OKButton       = 1;
    CanButton      = 2;
    CodeItem       = 4;
    DateItem       = 6;
    FNameItem      = 8;
    LNameItem      = 10;
    CompanyItem    = 12;
    AddressItem    = 14;
    CityItem       = 16;
    StateItem      = 18;
    ZipItem        = 20;
    PhoneItem      = 22;
    ExtensionItem  = 24;

  badDLogID       = 130;

  StringID        = 128;
  aboutID         = 128;

  dupEntrErr      = 1;
  noKeyErr        = 2;

  title1          = 'Turbo Pascal® DataBase Example 1.00';
  title2          = '©1987 Borland International';

  returnKey       = 13;       { ASCII for return key }

  MaxCells        = 14;
     recLength          = 11;
     WindX1              = 250;
     WindY1               = 125;
     WindY2               = 268;

type
    Buffer          = packed array[0..Maxint] of Char;
    BufferPtr       = ^Buffer;
    ProcPtr         = ^Integer;

    FileRec         = record
                        fInpFlag:       Boolean;
                        fOutFlag:       Boolean;
                        fRefNum:        Integer;
                        fVRefNum:       Integer;
                        fBufSize:       Integer;
                        fBufPos:        Integer;
                        fBufEnd:        Integer;
                        fBuffer:        BufferPtr;
                        fInOutProc:     ProcPtr;
                      end;
Var
    MenuList            : array[1..MenuCnt] of MenuHandle; { holds menu info }
    entrDLog,srchDLog   : DialogPtr;
    quit                : boolean;
    brect               : Rect;
    ENOKButtonHD,
    SROKButtonHD,
    LNameButtonHD,
    CustCodeButtonHD,
    FindEButtonHD,
    FindTextHD          : ControlHandle;
    temp                : integer;
    SIndx               : ^IndexFile;
    DLOGDirty           : Boolean;
    OldKeyN             : String;
    mcount1             : integer;
    LView               : WindowPtr;
    LArray              : Array[1..MaxCells] of longint;
    LHScrollBar,
       LVScrollBar            : ControlHandle;

procedure CleanUp;
begin
 CloseIndex(CodeIndx);
 CloseIndex(NameIndx);
 CloseFile(CustFile);
 if Boolean(LView) then DisposeWindow(LView);
end;

procedure Die;
begin
 CleanUp;
 ExitToShell;
end;

Var aboutBoxPtr : WindowPtr;
    aboutIndex  : integer;

procedure DoAboutBox;
var thisPort    : GrafPtr;
    lineHight   : integer;
    finfo       : FontInfo;
    tempRect    : Rect;
    LR,TB       : integer;
begin
 getPort(thisPort);
 if aboutBoxPtr = Pointer(0) then
 begin
  tempRect := screenBits.bounds;
  with screenBits.bounds do InsetRect(tempRect,
                                (right-left) div 2 - (355 div 2),
                                (bottom-top) div 2 - (85 div 2));
  aboutBoxPtr := NewWindow(nil,tempRect,'',False,2,Pointer(-1),false,0);
  setport(aboutBoxPtr);
  ShowWindow(aboutBoxPtr);
  with thePort^.portRect do
   begin
    ForeColor(WhiteColor);
    PaintRect(thePort^.portRect);
    TextFont(geneva);
    TextFace([Bold]);
    TextSize(10);
    GetFontInfo(finfo);
    ForeColor(RedColor);
    with finfo do linehight := ascent+descent+leading;
    LR := (right-left) div 2;
    TB := (bottom-top) div 2;
    moveto(LR - (StringWidth(title1) div 2),
           TB - linehight);
    DrawString(title1);
    moveto(LR - (StringWidth(title2) div 2),
           TB);
    DrawString(title2);
   end;
 end;
 aboutIndex := aboutIndex + 1;
 ForeColor(BlackColor);
 setport(thisPort);
end;

procedure KillAbout;
begin
 aboutIndex := 0;
 DisposeWindow(aboutBoxPtr);
 aboutBoxPtr := Pointer(0);
end;

function KeyFromName(LastNm : String; FirstNm : String) : String;
const
  Blanks  =  '               ';
begin
  KeyFromName := UpcaseStr(LastNm) +
                 Copy(Blanks,1,15 - Length(LastNm)) +
                 UpcaseStr(FirstNm);
end;

procedure AddRecord;
var tempString  : String;
    tempRec     : CustRec;
    CurItem     : integer;
    itemType    : integer;
    item        : Handle;
    box         : Rect;
    dateTime    : Longint;

begin
 OldKeyN := '';
 TempString := '';
 with tempRec do
 begin
   CurItem := CodeItem;
   repeat
     GetDItem(entrDLog, CurItem, itemType, item , box);
     SetIText(item, TempString);
     CurItem := CurItem + 2;
   until CurItem > ExtensionItem;
 end;
 GetDateTime(dateTime);
 IUDateString(dateTime,shortDate,TempString);
 GetDItem(entrDLog, DateItem, itemType, item , box);
 SetIText(item, TempString);
 SelIText(entrDLog, FNameItem, 0, 1);
end;

procedure DelRecord;
var tempCode,
    tempFirstName,
    tempLastName,
    KeyN        : Str255;
    tempRec     : CustRec;
    itemType    : integer;
    item        : Handle;
    box         : Rect;
    DataF,
    tempL       : Longint;

begin
 GetDItem(entrDLog, CodeItem, itemType, item , box);
 GetIText(item,tempCode);
 GetDItem(entrDLog, FNameItem, itemType, item , box);
 GetIText(item,tempFirstName);
 GetDItem(entrDLog, LNameItem, itemType, item , box);
 GetIText(item,tempLastName);
 StringToNum(tempCode,tempL);
 tempCode := LongToStr(tempL);
 FindKey(CodeIndx, DataF, tempCode);
 if OK then
  begin
   DeleteRec(CustFile,DataF);
   KeyN := KeyFromName(tempLastName,tempFirstName);
   DeleteKey(NameIndx,DataF,KeyN);
   DeleteKey(CodeIndx,DataF,tempCode);
   AddRecord;
  end
 else
  SysBeep(10);
end;

procedure UpDateRecordOnDLOG(tempRec: CustRec);
var tempString  : String;
    CurItem     : integer;
    itemType    : integer;
    item        : Handle;
    box         : Rect;

begin
 SelectWindow(entrDLog);
 TempString := '';
 with tempRec do
 begin
   CurItem := CodeItem;
   repeat
     GetDItem(entrDLog, CurItem, itemType, item , box);
     case CurItem of
       CodeItem     : NumToString(CustCode,TempString);
       DateItem     : TempString := Date;
       FNameItem    : TempString := FName;
       LNameItem    : TempString := LName;
       CompanyItem  : TempString := Company;
       AddressItem  : TempString := Address;
       CityItem     : TempString := City;
       StateItem    : TempString := State;
       ZipItem      : TempString := Zip;
       PhoneItem    : TempString := Phone;
       ExtensionItem: TempString := Extension;
     end;
     SetIText(item, TempString);
     CurItem := CurItem + 2;
   until CurItem > ExtensionItem;
   OldKeyN := KeyFromName(LName,FName);
 end;
end;

procedure HitOK; forward;

procedure DoFirstSearch;
var tempKey     : String;
    tempRecNum  : Longint;
    tempRec     : CustRec;
begin
 ClearKey(SIndx^);
 NextKey(SIndx^, tempRecNum, TempKey);
 if OK then begin
              HitOk;
              GetRec(CustFile,tempRecNum,tempRec);
              UpDateRecordOnDLOG(tempRec);
            end;
end;


procedure DoLastSearch;
var tempKey     : String;
    tempRecNum  : Longint;
    tempRec     : CustRec;
begin
 ClearKey(SIndx^);
 PrevKey(SIndx^, tempRecNum, TempKey);
 if OK then begin
              HitOk;
              GetRec(CustFile,tempRecNum,tempRec);
              UpDateRecordOnDLOG(tempRec);
            end;
end;

procedure DoNextSearch;
var tempKey     : String;
    tempRecNum  : Longint;
    tempRec     : CustRec;
begin
  repeat
    NextKey(SIndx^, tempRecNum, TempKey);
  until OK;
  HitOk;
  GetRec(CustFile,tempRecNum,tempRec);
  UpDateRecordOnDLOG(tempRec);
end;

procedure DoPrevSearch;
var tempKey     : String;
    tempRecNum  : Longint;
    tempRec     : CustRec;
begin
  repeat
     PrevKey(SIndx^, tempRecNum, TempKey);
  until OK;
  HitOk;
  GetRec(CustFile,tempRecNum,tempRec);
  UpDateRecordOnDLOG(tempRec);
end;

procedure DoSearchOn;
begin
 SelectWindow(srchDLog);
end;

procedure BadEntry(theErr : integer);
var tempDPtr : DialogPtr;
    tempStr  : Str255;
    temp     : integer;
begin
 GetIndString(tempStr,StringID,theErr);
 paramtext(tempStr,'','','');
 tempDPtr := GetNewDialog(badDLogID,nil,Pointer(-1));
 ModalDialog(nil,temp);
 DisposDialog(tempDPtr);
end;

procedure CopyRecFromDLOG(Var tempRec : CustRec);
var TempString  : Str255;
    itemhit     : integer;
    itype       : integer;
    itemHandle  : Handle;
    box         : rect;
begin
 itemhit := CodeItem;
 repeat
  GetDItem(entrDLog, ItemHit, IType, ItemHandle , box);
  GetIText(ItemHandle, TempString);
     with tempRec do
       case ItemHit of
         CodeItem       : StringToNum(TempString,CustCode);
         DateItem       : Date      := TempString;
         FNameItem      : FName     := TempString;
         LNameItem      : LName     := TempString;
         CompanyItem    : Company   := TempString;
         AddressItem    : Address   := TempString;
         CityItem       : City      := TempString;
         StateItem      : State     := TempString;
         ZipItem        : Zip       := TempString;
         PhoneItem      : Phone     := TempString;
         ExtensionItem  : Extension := TempString;
         otherwise ;
      end;
  itemHit := itemHit + 2;
 until (itemHit > ExtensionItem);
end;


const
 CellSizeX = 123;
 CellSizeY = 18;

procedure ListView;
Var    wName           : Str255;
        r,
        rv,
        dv              : Rect;
        p               : point;
        tempKey        : String;
        tempRecNum    : Longint;
        tempRec        : CustRec;
        x                : integer;
begin
 if Not Boolean(LView) then
  begin
   GetItem(MenuList[4],ListVItem,wName);
   r := screenBits.bounds;
   with r do
    begin
     Top := ((Top + bottom) div 2) - WindY1;
     left := ((Right + Left) div 2) - WindX1;
     right := left + CellSizeX*4 + 16;
     bottom := top + WindY2;
    end;
   p.h := 150;
   p.v := 0;
   LView := NewWindow(nil,r,wName,True,0,Pointer(-1),True,0);
    GlobalToLocal(r.botRight);
    r.top     := WindY2-16;
    r.bottom := WindY2;
    r.left     := 0;
    r.right     := CellSizeX*4;
    LHScrollBar := NewControl(LView,r,'',true,0,0,recLength*CellSizeX-(4*CellSizeX),scrollBarProc,0);
    r.top     := 0;
    r.bottom := WindY2-16;
    r.left     := CellSizeX*4;
    r.right     := CellSizeX*4+16;
    LVScrollBar := NewControl(LView,r,'',true,1,1,UsedRecs(CustFile)-MaxCells,scrollBarProc,0);
(* Build the List Array *)
 for x := 1 to MaxCells do
   LArray[x] := -1;

   ClearKey(CodeIndx);
   x := 1;
   while Ok and (x <= MaxCells) do
   begin
        NextKey(CodeIndx, tempRecNum, TempKey);
        if OK then
     begin
       LArray[x] := tempRecNum;
       x := succ(x);
     end;
      end;
 end
 else
  SelectWindow(LView);
end;

procedure LDrawWindow;
var    x             : integer;
        thisPort : GrafPtr;
        r             : rect;

    (* DrawLine will Draw Line #line. It will know where to draw it *)
    procedure DrawLine(line : integer);
 Var    r                 : rect;
        y1             : integer;
        s              : String;
        cust             : CustRec;
        tempKey     : String;
        tempRecNum  : Longint;
        x,ct             : integer;
    begin
        if (LArray[line] <> -1) then
        begin
            tempKey := LongToStr(LArray[line]);
            FindKey(CodeIndx, tempRecNum, tempKey);
            if OK then
            with cust do
             begin
                GetRec(CustFile,tempRecNum,cust);
                y1 := ((line-1)*CellSizeY)+14;
                ct := GetCtlValue(LHScrollBar);
                for x := 1 to recLength do
                begin
                    SetRect(r,CellSizeX*(x-1)-ct,y1-14,CellSizeX*x+1-ct,y1+CellSizeY-14);
                    EraseRect(r);
                    FrameRect(r);
                    moveto(CellSizeX*(x-1)+2-ct,y1-3);
                    case x of
                    1: begin NumToString(LArray[line],s); DrawString(s); end;
                    2: DrawString(Date);
                    3: DrawString(FName);
                    4: DrawString(LName);
                    5: DrawString(Company);
                    6: DrawString(Address);
                    7: DrawString(City);
                    8: DrawString(State);
                    9: DrawString(Zip);
                  10: DrawString(Phone);
                  11: DrawString(Extension);
                 end;
                end;
             end;
        end
      else
       begin
            y1 := ((line-1)*CellSizeY)+14;
            ct := GetCtlValue(LHScrollBar);
            for x := 1 to recLength do
            begin
                SetRect(r,CellSizeX*(x-1)-ct,y1-14,CellSizeX*x+1-ct,y1+CellSizeY-14);
                EraseRect(r);
                FrameRect(r);
                moveto(CellSizeX*(x-1)+2-ct,y1-3);
            end;
        end;
    end;

begin (* LDrawWindow *)
 GetPort(thisPort);
 SetPort(LView);
 BeginUpDate(LView);
    r.top     := 0;
    r.bottom := WindY2-16;
    r.right     := CellSizeX*4;
    r.left    := 0;
    RectRgn(LView^.clipRgn,r);
    for x := 1 to MaxCells do DrawLine(x);
    r.top     := 0;
    r.bottom := WindY2;
    r.right     := CellSizeX*4+16;
    r.left    := 0;
    RectRgn(LView^.clipRgn,r);
    DrawControls(LView);
 EndUpDate(LView);
 SetPort(thisPort);
end; (* LDrawWindow *)

procedure NextEntry(many : integer);
var     x             : integer;
         r             : rect;
        tempCode    : Str255;
        DataF        : longint;
        LifeOK    : Boolean;
begin
    if LArray[MaxCells] = -1 then exit;
    x := 1;
    if many = 1 then for x := 1 to MaxCells-many do LArray[x] := LArray[x+1];
    if many = MaxCells-1 then LArray[1] := LArray[MaxCells];
   tempCode := LongToStr(LArray[x]);
   FindKey(CodeIndx, DataF, tempCode);
    LifeOK := True;
    for x := MaxCells-many+1 to MaxCells do
    begin
     if LifeOK then
      begin
         NextKey(CodeIndx, DataF, tempCode);
         if OK then LArray[x] := DataF
                  else begin
                          LArray[x] := -1;
                         LifeOK := False;
                        end;
      end
     else
      LArray[x] := -1;
    end;
    r := LView^.portRect;
    r.bottom := r.bottom-16;
    r.right := r.right-16;
    InvalRect(r);
    LDrawWindow;
end;

procedure PrevEntry(many : integer);
var     x,y        : integer;
         r             : rect;
        tempCode    : Str255;
        DataF        : longint;
        LifeOK    : Boolean;
begin
    for y := 1 to many do
        for x := MaxCells downto 1 do LArray[x] := LArray[x-1];
   tempCode := LongToStr(LArray[many+1]);
   FindKey(CodeIndx, DataF, tempCode);
    LifeOK := OK;
    for x := many downto 1 do
    begin
     if LifeOK then
      begin
         PrevKey(CodeIndx, DataF, tempCode);
         if OK then LArray[x] := DataF
                  else begin
                         LifeOK := False;
                        end;
      end
     else
    end;
    r := LView^.portRect;
    r.bottom := r.bottom-16;
    r.right := r.right-16;
    InvalRect(r);
    LDrawWindow;
end;

procedure LHScrollControl(theControl: ControlHandle; partCode: integer);
var    r: rect;
begin
 case partCode of
  inUpButton:         SetCtlValue(theControl,GetCtlValue(theControl)-10);
  inDownButton:     SetCtlValue(theControl,GetCtlValue(theControl)+10);
  inPageUp:            begin
                           if (GetCtlValue(theControl)-CellSizeX) <> 0 then
                              SetCtlValue(theControl,((GetCtlValue(theControl)-CellSizeX) div CellSizeX)*CellSizeX)
                         else
                           SetCtlValue(theControl,0);
                        end;
  inPageDown:         begin
                        if (GetCtlValue(theControl)+CellSizeX) <> 0 then
                            SetCtlValue(theControl,((GetCtlValue(theControl)+CellSizeX) div CellSizeX)*CellSizeX)
                         else
                          SetCtlValue(theControl,CellSizeX);
                        end;

 end;
 if GetCtlValue(theControl) < 0 then SetCtlValue(theControl,0);
 if (theControl = LHScrollBar) and (GetCtlValue(theControl) > recLength*CellSizeX)
     then SetCtlValue(theControl,recLength*CellSizeX);
 r := LView^.portRect;
 r.bottom := r.bottom-16;
 r.right := r.right-16;
 InvalRect(r);
 LDrawWindow;
end;

procedure LVScrollControl(theControl: ControlHandle; partCode: integer);
var    r: rect;
begin
 case partCode of
  inUpButton:         begin
                           if GetCtlValue(theControl) > 1 then
                          begin
                           PrevEntry(1);
                           SetCtlValue(theControl,GetCtlValue(theControl)-1);
                          end;
                        end;
  inDownButton:     begin
                           if GetCtlValue(theControl)+1 > UsedRecs(CustFile)then
                          begin
                           end
                         else
                          begin
                             SetCtlValue(theControl,GetCtlValue(theControl)+1);
                           NextEntry(1);
                          end;
                        end;
  inPageUp:            begin
                          if (GetCtlValue(theControl)-MaxCells-1 < 1) and
                              (GetCtlValue(theControl) <> 1)
                         then begin
                                 PrevEntry(GetCtlValue(theControl)-1);
                                SetCtlValue(theControl,1);
                              end
                         else begin
                                SetCtlValue(theControl,GetCtlValue(theControl)-MaxCells-1);
                               PrevEntry(MaxCells-1);
                              end;
                        end;
  inPageDown:         begin
                           if GetCtlValue(theControl)+MaxCells-1 > UsedRecs(CustFile)
                          then begin
                                  NextEntry(UsedRecs(CustFile)-GetCtlValue(theControl));
                                    SetCtlValue(theControl,UsedRecs(CustFile));
                                 end
                          else begin
                                     SetCtlValue(theControl,GetCtlValue(theControl)+MaxCells-1);
                                   NextEntry(MaxCells-1);
                                 end;
                        end;

 end;
 if GetCtlValue(theControl) < 1 then SetCtlValue(theControl,1);
 if (theControl = LVScrollBar) and (GetCtlValue(theControl) > UsedRecs(CustFile))
     then SetCtlValue(theControl,UsedRecs(CustFile));
 r := LView^.portRect;
 r.bottom := r.bottom-16;
 r.right := r.right-16;
 InvalRect(r);
 LDrawWindow;
end;

procedure HitOK;
Var tempRec : CustRec;
    DataF   : Longint;
    KeyN    : String[25];
    tempSPtr: StringPtr;
    tempCode: Longint;
    tempStr : String;
    tempLS  : LongIntStr;

begin (* HitOK *)
if DLOGDirty then
 begin
  CopyRecFromDLog(tempRec);
  with tempRec do
  begin
    if CustCode <> 0 then
    begin
      tempStr := LongToStr(CustCode);
      FindKey(CodeIndx, DataF, tempStr);
      if OK then
      begin
         PutRec(CustFile, DataF, tempRec);
         KeyN := KeyFromName(LName,FName);
         if OldKeyN <> KeyN then
         begin
           { Remove it if it was already there }
           DeleteKey(NameIndx, DataF, OldKeyN);
           AddKey(NameIndx, DataF, KeyN);
         end;
      end;
     end
     else
       if (LName <> '') and (FName <> '') then
       begin
          KeyN := KeyFromName(LName,FName);
          begin
           AddRec(CustFile, DataF, tempRec);
           tempLS := LongToStr(DataF);
           CustCode := DataF;
           PutRec(CustFile, DataF, tempRec);
           AddKey(CodeIndx, DataF, tempLS);
           KeyN := KeyFromName(LName,FName);
           AddKey(NameIndx, DataF, KeyN);
           UpDateRecordOnDLOG(tempRec);
           AddRecord;
         end
       end
       else
         BadEntry(noKeyErr);
     DLOGDirty := False;
   end; { with }
 end; { if }
end; (* HitOK *)

procedure HitSearchBox(itemHit : integer);

    procedure Find;
    var tempKey,
        tempText : Str255;
        DataF,
        tempL    : longint;
        tempRec  : CustRec;
        tempK    : LongIntStr;
    begin
     GetIText(Handle(FindTextHD),tempText);
     tempText := UpCaseStr(tempText);
     tempKey := tempText;
     if SIndx = @NameIndx then
      begin                                 (* Find on name *)
       if (Boolean(GetCtlValue(FindEButtonHD))) then tempText := tempText + ' ';
       SearchKey(SIndx^,DataF, tempKey);
       if (OK) and (Pos(tempText,tempKey) = 1) then
        begin
          GetRec(CustFile,DataF,tempRec);
          HitOK;                               (* save old entry in Dialog *)
          UpDateRecordOnDLOG(tempRec);
        end
       else SysBeep(10);
      end
     else
      begin                                 (* Find on Cust Code*)
       StringToNum(tempKey,tempL);
       tempK := LongToStr(tempL);
       FindKey(SIndx^,DataF, tempK);
       if OK then
        begin
         GetRec(CustFile,DataF,tempRec);
         HitOK;                               (* save old entry in Dialog *)
         UpDateRecordOnDLOG(tempRec);
        end
       else SysBeep(10);
      end;
    end;

begin
 case itemHit of
  FindExact     : SetCtlValue(FindEButtonHD,(GetCtlValue(FindEButtonHD)+1) and 1);
  OKButton      : Find;
  CanButton     : ;
  LNameSearch   : begin
                   SetCtlValue(LNameButtonHD,1);
                   SetCtlValue(CustCodeButtonHD,0);
                   SIndx := @NameIndx;
                   HiliteControl(FindEButtonHD,0);
                 end;
  CustCodeSearch: begin
                   SetCtlValue(LNameButtonHD,0);
                   SetCtlValue(CustCodeButtonHD,1);
                   SIndx := @CodeIndx;
                   HiliteControl(FindEButtonHD,255);
                  end;
 end;
end;

var event       : EventRecord;
    whichDlog   : DialogPtr;
    wItemHit    : integer;

    procedure CheckMenus;
    Var currentRec  : CustRec;
        err         : integer;
        f           : ^FileRec;
        wind        : WindowPeek;
    begin
     CopyRecFromDLog(currentRec);
      if FrontWindow = entrDLog then
       begin
          if currentRec.CustCode <= 0 then DisableItem(MenuList[4],DelRecItem)
                                              else EnableItem(MenuList[4],DelRecItem);
        end
      else
       DisableItem(MenuList[4],DelRecItem);
      wind := WindowPeek(FrontWindow);
     if wind <> WindowPeek(0) then
      if (wind^.windowKind < 0) then begin
                                      EnableItem(MenuList[3],undoItem);
                                      DisableItem(MenuList[2],0);
                                      DisableItem(MenuList[4],0);
                                      DisableItem(MenuList[5],0);
                                      if BitAnd(mcount1,$4000)=0 then DrawMenuBar;
                                      BitSet(@mcount1,1);
                                     end
                                else begin
                                      DisableItem(MenuList[3],undoItem);
                                      EnableItem(MenuList[2],0);
                                      EnableItem(MenuList[4],0);
                                      EnableItem(MenuList[5],0);

                                      if UsedRecs(CustFile) = 0 then
                                       begin
                                        DisableItem(MenuList[5],0);
                                        if not BitTst(@mcount1,0) then DrawMenuBar;
                                        BitSet(@mcount1,0);
                                       end
                                      else
                                       begin
                                        if BitTst(@mcount1,0) then DrawMenuBar;
                                        BitClr(@mcount1,0);
                                       end;

                                      if BitAnd(mcount1,$4000)>0 then DrawMenuBar;
                                      BitClr(@mcount1,1);
                                     end;

    end;

    function TextToStr(h : Handle; offset1,offset2 : Longint) : Str255;
    var temp    : Longint;
        x       : integer;
        c       : char;
        s       : str255;
        p       : Ptr;
    begin
     s := '';
     HLock(h);
     p := Ptr(longint(h^) + offset1);
     for x := 0 to offset2-offset1-1 do
      begin
       s := s + char(p^);
       p := ptr(longint(p) + 1);
      end;
     HUnLock(h);
     TextToStr := s;
    end;

    procedure DoMenu(key : Boolean);
    var x,templ     : longint;
        mItem       : integer;
        temp        : integer;
        thisPort    : GrafPtr;
        tempStr     : Str255;
        hte         : TEHandle;
        tempR       : Rect;
        Cust        : CustRec;
        textlength  : integer;
        scrapSize,
        offset1,
        offset2     : longint;
        hDest       : Handle;
        searchChar  : integer;
        CurrentEItem: integer;
        item        : Handle;
        ItemType    : integer;
        box         : Rect;

    begin
     if Key then x := MenuKey(char(event.message and charCodeMask))
            else x := MenuSelect(event.where);
     mItem := LoWord(x);
     case HiWord(x) of
        applMenuID : if mItem > 2 then
                      begin
                       GetPort(thisPort);
                       GetItem(MenuList[applMenuID-menuStart+1],mItem,tempStr);
                       temp := OpenDeskAcc(tempStr);
                       SetPort(thisPort);
                      end
                     else
                      begin
                       repeat
                        DoAboutBox;
                       until GetNextEvent(mouseDown+keyDown,event);
                       FlushEvents(everyEvent,0);
                       KillAbout;
                      end;

        fileMenuID : case mItem of
                      quitItem : begin
                                   HitOk;
                                   quit := true;
                                 end;
                     end; (* case *)
        editMenuID : if not SystemEdit(mItem-1) then
                      case mItem of
                       undoItem : ;
                       cutItem  : begin
                                   DlgCut(FrontWindow);
                                   templ := TEToScrap;
                                  end;
                       copyItem : begin
                                   if Boolean(event.modifiers and optionKey) then
                                    with Cust do
                                     begin
                                      CopyRecFromDLOG(Cust);
                                      SetRect(tempR,0,0,1,1);
                                      hTE := TENew(tempR,tempR);
                                      textLength := 0;

                                      TEInsert(ptr(Longint(@FName)+1),Length(FName),hTE);
                                      TEKey(^I,hTE);
                                      textlength := textlength + Length(FName)+1;

                                      TEInsert(ptr(Longint(@LName)+1),Length(LName),hTE);
                                      TEKey(^I,hTE);
                                      textlength := textlength + Length(LName)+1;

                                      TEInsert(ptr(Longint(@Company)+1),Length(Company),hTE);
                                      TEKey(^I,hTE);
                                      textlength := textlength + Length(Company)+1;

                                      TEInsert(ptr(Longint(@Address)+1),Length(Address),hTE);
                                      TEKey(^I,hTE);
                                      textlength := textlength + Length(Address)+1;

                                      TEInsert(ptr(Longint(@City)+1),Length(City),hTE);
                                      TEKey(^I,hTE);
                                      textlength := textlength + Length(City)+1;

                                      TEInsert(ptr(Longint(@State)+1),Length(State),hTE);
                                      TEKey(^I,hTE);
                                      textlength := textlength + Length(State)+1;

                                      TEInsert(ptr(Longint(@Zip)+1),Length(Zip),hTE);
                                      TEKey(^I,hTE);
                                      textlength := textlength + Length(Zip)+1;

                                      TEInsert(ptr(Longint(@Phone)+1),Length(Phone),hTE);
                                      TEKey(^I,hTE);
                                      textlength := textlength + Length(Phone)+1;

                                      TEInsert(ptr(Longint(@Extension)+1),Length(Extension),hTE);
                                      TEKey(^I,hTE);
                                      textlength := textlength + Length(Extension)+1;

                                      TESetSelect(0,textlength,hTE);
                                      TECopy(hTE);
                                      templ := TEToScrap;
                                      TEDispose(hTE);
                                     end
                                    else
                                     begin
                                      DlgCopy(FrontWindow);
                                      templ := TEToScrap;
                                     end;
                                  end;
                       pasteItem: begin
                                   HitOK;
                                   hDest := NewHandle(0);
                                   searchChar := $0900;
                                   CurrentEItem := DialogPeek(entrDLOg)^.editField+1;
                                   scrapSize := GetScrap(hDest,'TEXT',offset1);
                                   offset1 := 0;
                                   if Boolean(scrapSize) then
                                    begin
                                     AddRecord;
                                     DLOGDirty := True;
                                     repeat
                                      offset2 := Munger(hDest,offset1,
                                                       @searchChar,1,
                                                       Nil,0);
                                      if offset2 > 0
                                       then
                                        begin
                                         tempStr := TextToStr(hDest,offset1,
                                                             offset2);
                                         GetDItem(entrDLog,CurrentEItem,
                                                 itemType,item,box);
                                         SetIText(item,tempStr);
                                         CurrentEItem := CurrentEItem+2;
                                         offset1 := offset2+1;
                                        end
                                       else
                                        begin
                                         templ := TEFromScrap;
                                         DlgPaste(FrontWindow);
                                        end;
                                     until ((offset1 >=  scrapSize) or
                                            (offset2 < 0));
                                    end
                                  end;
                       clearItem: begin
                                   DlgDelete(FrontWindow);
                                   templ := TEToScrap;
                                  end;
                      end;
        dataMenuID : begin
                       HitOk;
                       case mItem of
                         AddRecItem : AddRecord;
                         DelRecItem : DelRecord;
                         LIstVItem  : ListView;
                       end;
                     end;
        srchMenuID : case mItem of
                       FirstItem : DoFirstSearch;
                       LastItem  : DoLastSearch;
                       NextItem  : DoNextSearch;
                       PrevItem  : DoPrevSearch;
                       SOnItem   : DoSearchOn;
                     end;
      end; (* case *)
     HiLiteMenu(0);
    end;

    procedure DoMouse;
    var    whichWindow     : WindowPtr;
            whichControl     : ControlHandle;
            pt              : point;
            part                : integer;
            r                    : rect;
            pp                    : ProcPtr;
    begin (* Do Mouse *)
     case FindWindow(event.where, whichWindow) of
        inDesk      : ;
        inMenuBar   : DoMenu(False);
        inSysWindow : SystemClick(event, whichWindow);
        inContent   : begin
                       SelectWindow(whichWindow);
                       if whichWindow = LView then
                               begin
                                 SetPort(LView);
                                 GlobalToLocal(event.where);
                                 part := FindControl(event.where,whichWindow,whichControl);
                                 if Boolean(whichControl) then
                                  begin
                                   if (part = inThumb) then
                                     begin
                                       if (whichControl <> LVScrollBar) then
                                         begin
                                          part := TrackControl(whichControl,event.where,Nil);
                                          r := LView^.portRect;
                                          r.bottom := r.bottom-16;
                                          EraseRect(r);
                                          InvalRect(r);
                                         end;
                                     end
                                    else
                                     begin
                                      pp := @LHScrollControl;
                                      if whichControl = LVScrollBar then pp := @LVScrollControl;
                                      part := TrackControl(whichControl,event.where,Ptr(pp));
                                     end;
                                  end;
                                end;
                      end;
        inDrag      : DragWindow(whichWindow, event.where, brect);
          inGoAway      : begin
                                  if TrackGoAway(whichWindow,event.where) then
                                 begin
                                  DisposeWindow(LView);
                                  LView := WindowPtr(0);
                                 end;
                             end;
       end; (* case *)
    end; (* Do Mouse *)

    procedure DoKey;
    begin
     if Boolean(event.modifiers and cmdKey) then DoMenu(True);
    end;

    procedure DoUpDate;
    begin
     if WindowPtr(event.message) = LView then
        LDrawWindow
    end;

    procedure DoAct;
    begin
    end;

    procedure HitButton(wItemHit : integer);

        procedure HitCanButton;
        var tempRec : CustRec;
            tempStr : LongIntStr;
            DataF   : Longint;
        begin
         CopyRecFromDLog(tempRec);
         with tempRec do
          begin
           if CustCode = 0 then
            AddRecord
           else
            begin
             tempStr := LongToStr(CustCode);
             FindKey(CodeIndx, DataF, tempStr);
             if OK then
              begin
               GetRec(CustFile,DataF,tempRec);
               UpDateRecordOnDLOG(tempRec);
              end;
            end;
          end;
        end;

    begin (* HitButton *)
     case wItemHit of
        OKButton    : HitOK;
        CanButton   : HitCanButton;
     end;
    end; (* HitButton *)


    function DEvent : Boolean;
    var temp        : boolean;
        tempWindow  : WindowPtr;
        tempint     : integer;
    begin
     if Boolean(event.modifiers and cmdKey) then begin
                                                  DEvent := False;
                                                  Exit;
                                                 end;
     temp := IsDialogEvent(event);
     DEvent := temp;
     if temp then
       with event do
         begin
          if (what = keyDown) then
           begin
            if (message and charCodeMask) = returnKey then
             begin              (* Make pressing the return key look like the*)
              what := nullEvent;(* user hit the OK button                    *)
              if FrontWindow = entrDLog then
               begin
                HiliteControl(ENOKButtonHD,1);
                HitButton(OKButton);
                HiliteControl(ENOKButtonHD,0);
               end
              else
               begin
                HiliteControl(SROKButtonHD,1);
                HitSearchBox(OKButton);
                HiliteControl(SROKButtonHD,0);
               end;
             end;
           end;
          if DialogSelect(event,whichDlog,wItemHit) then
           if (whichDLog = entrDLog) then
            begin
             if (what = keyDown) then DLOGDirty := True;
             if (wItemHit <= CanButton) then HitButton(wItemHit);
            end
           else
            if (whichDLog = srchDLog) then
             begin
              HitSearchBox(wItemHit);
             end;
         end
    end;

procedure SetUp;
Var itemType : integer;
    item     : Handle;
    box      : Rect;
    templ    : longint;

    procedure InitMangers;
    begin
     InitGraf(@thePort);
     InitFonts;
     InitWindows;
     InitMenus;
     TEInit;
     InitDialogs(Nil);
     InitCursor;
     FlushEvents(everyEvent,0);
     MoreMasters;
     MoreMasters;
     MaxApplZone;
    end;

    procedure PutUpMenus;
    var x : integer;
    begin
     for x := 1 to MenuCnt do
      begin
       MenuList[x] := GetMenu(applMenuID+x-1);
       if boolean(MenuList[x]) then InsertMenu(MenuList[x],0);
      end;
     AddResMenu(MenuList[1],'DRVR');
     DrawMenuBar;
    end;

    procedure InitDataBase;
    begin
     InitCustDatabase;
    end;

    procedure PutUpDialog;
    begin
     entrDLog := GetNewDialog(entrDLogID,nil,Pointer(0));
     if not boolean(entrDLog) then Die;
     srchDLog := GetNewDialog(srchDLogID,nil,Pointer(0));
     if not boolean(entrDLog) then Die;
     (* push last name button *)
     GetDItem(srchDLog,LNameSearch,itemType,item,box);
     SetCtlValue(ControlHandle(item),1);
     SetPort(entrDLog);
    end;

begin (* SetUp *)
 InitMangers;
 aboutBoxPtr := Pointer(0);
 DoAboutBox;
 PutUpMenus;
 InitDataBase;
 PutUpDialog;
 quit := false;
 AddRecord;

 brect := ScreenBits.bounds;
 insetRect(brect,4,4);

 GetDItem(entrDLog,OKButton,itemType,item,box);
 HNoPurge(item);
 ENOKButtonHD := ControlHandle(item);

 GetDItem(srchDLog,OKButton,itemType,item,box);
 HNoPurge(item);
 SROKButtonHD := ControlHandle(item);
 GetDItem(srchDLog,LNameSearch,itemType,item,box);
 HNoPurge(item);
 LNameButtonHD := ControlHandle(item);
 GetDItem(srchDLog,CustCodeSearch,itemType,item,box);
 HNoPurge(item);
 CustCodeButtonHD := ControlHandle(item);
 GetDItem(srchDLog,FindExact,itemType,item,box);
 HNoPurge(item);
 FindEButtonHD := ControlHandle(item);
 GetDItem(srchDLog,SearchText,itemType,item,box);
 HNoPurge(item);
 FindTextHD := ControlHandle(item);

 SIndx := @NameIndx;
 DLOGDirty := False;
 OldKeyN := '';
 mcount1 := 0;
 templ := ZeroScrap;
 LView := WindowPtr(0);
 KillAbout;
end; (* SetUp *)

begin
  SetUp;
  while not quit do
  begin
    CheckMenus;
    SystemTask;
    if GetNextEvent(everyEvent,event) then
    begin
      if not DEvent then
       case event.what of
          nullEvent          : SystemTask;
          mouseDown          : DoMouse;
          keyDown,autoKey    : DoKey;
          updateEvt          : DoUpDate;
          activateEvt        : DoAct;
       end; { case }
    end
    else if DEvent then ;
  end;
  CleanUp;
end.